home *** CD-ROM | disk | FTP | other *** search
/ Dr. Windows 3 / dr win3.zip / dr win3 / UTILITY1 / MSWSRC35.ZIP / INTERN.CPP < prev    next >
C/C++ Source or Header  |  1993-08-26  |  4KB  |  138 lines
  1. /*
  2.  *      intern.c        logo data interning module              dvb
  3.  *
  4.  *    Copyright (C) 1989 The Regents of the University of California
  5.  *    This Software may be copied and distributed for educational,
  6.  *    research, and not for profit purposes provided that this
  7.  *    copyright and statement are included in all such copies.
  8.  *
  9.  */
  10.  
  11. #include "logo.h"
  12. #include "globals.h"
  13.  
  14. NODE **hash_table;
  15.  
  16. void map_oblist(void (*fcn)(NODE *))
  17. {
  18.     int i;
  19.     NODE *nd;
  20.  
  21.     for (i = 0; i < HASH_LEN; i++)
  22.     for (nd = hash_table[i]; nd != NIL; nd = cdr(nd))
  23.         (*fcn) (car(nd));
  24. }
  25.  
  26. int hash(char *s, int len)
  27.     /* Map S to an integer in the range 0 .. HASH_LEN-1. */
  28.     /* Method attributed to Peter Weinberger, adapted from Aho, Sethi, */
  29.     /* and Ullman's book, Compilers: Principles, Techniques, and */
  30.     /* Tools; figure 7.35. */
  31. {
  32.     unsigned int h = 0, g;
  33.  
  34.     while (--len >= 0) {
  35.     h = (h << 4) + *s++;
  36.     g = h & (0xf << (WORDSIZE-4));
  37.     if (g != 0) {
  38.         h ^= g ^ (g >> (WORDSIZE-8));
  39.     }
  40.     }
  41.     return h % HASH_LEN;
  42. }
  43.  
  44. NODE *make_case(NODE *casestrnd, NODE *obj)
  45. {
  46.     NODE *new_caseobj, *clistptr;
  47.  
  48.     clistptr = caselistptr__object(obj);
  49.     new_caseobj = make_caseobj(casestrnd, obj);
  50.     setcdr(clistptr, cons(new_caseobj, cdr(clistptr)));
  51.     return(new_caseobj);
  52. }
  53.  
  54. NODE *make_object(NODE *canonical, NODE *proc, NODE *val,
  55.           NODE *plist, NODE *casestrnd)
  56. {
  57.     NODE *temp;
  58.  
  59.     temp = cons_list(0, canonical, proc, val, plist,
  60.              make_intnode((FIXNUM)0), END_OF_LIST);
  61.     make_case(casestrnd, temp);
  62.     return(temp);
  63. }
  64.  
  65. NODE *make_instance(NODE *casend, NODE *lownd)
  66. {
  67.     NODE *obj;
  68.     int hashind;
  69.  
  70.     /* Called only if arg isn't already in hash table */
  71.  
  72.     obj = make_object(lownd, UNDEFINED, UNBOUND, NIL, casend);
  73.     hashind = hash(getstrptr(lownd), getstrlen(lownd));
  74.     push(obj,(hash_table[hashind]));
  75.     return car(caselist__object(obj));
  76. }
  77.  
  78. NODE *find_instance(NODE *lownd)
  79. {
  80.     NODE *hash_entry, *thisobj;
  81.     int cmpresult;
  82.  
  83.     hash_entry = hash_table[hash(getstrptr(lownd), getstrlen(lownd))];
  84.  
  85.     while (hash_entry != NIL) {
  86.     thisobj = car(hash_entry);
  87.     cmpresult = compare_node(lownd, canonical__object(thisobj), FALSE);
  88.     if (cmpresult == 0)
  89.         break;
  90.     else
  91.         hash_entry = cdr(hash_entry);
  92.     }
  93.     if (hash_entry == NIL) return(NIL);
  94.     else return(thisobj);
  95. }
  96.  
  97. int case_compare(NODE *nd1, NODE *nd2)
  98. {
  99.     if (backslashed(nd1) && backslashed(nd2)) {
  100.     if (getstrlen(nd1) != getstrlen(nd2)) return(1);
  101.     return(strncmp(getstrptr(nd1), getstrptr(nd2),
  102.                getstrlen(nd1)));
  103.     }
  104.     if (backslashed(nd1) || backslashed(nd2))
  105.     return(1);
  106.     return(compare_node(nd1, nd2, FALSE));
  107. }
  108.  
  109. NODE *find_case(NODE *strnd, NODE *obj)
  110. {
  111.     NODE *clist;
  112.  
  113.     clist = caselist__object(obj);
  114.     while (clist != NIL &&
  115.         case_compare(strnd, strnode__caseobj(car(clist))))
  116.     clist = cdr(clist);
  117.     if (clist == NIL) return(NIL);
  118.     else return(car(clist));
  119. }
  120.  
  121. NODE *intern(NODE *nd)
  122. {
  123.     NODE *obj, *casedes, *lownd;
  124.  
  125.     if (nodetype(nd) == CASEOBJ) return(nd);
  126.     nd = valref(cnv_node_to_strnode(nd));
  127.     lownd = make_strnode(getstrptr(nd), (char *)NULL,
  128.              getstrlen(nd), STRING, noparitylow_strnzcpy);
  129.     if ((obj = find_instance(lownd)) != NIL) {
  130.     if ((casedes = find_case(nd, obj)) == NIL)
  131.         casedes = make_case(nd, obj);
  132.     } else
  133.     casedes = make_instance(nd, lownd);
  134.     deref(nd);
  135.     gcref(lownd);
  136.     return(casedes);
  137. }
  138.